1 Introduction

Le projet en science des données représente l’aboutissement du certificat en science des données de l’Université TÉLUQ.Ce projet constitue un complément essentiel de formation pratique et vise à favoriser l’autonomie, l’esprit d’analyse et la rigueur méthodologique dans la conduite d’un projet complet en science des données.

En partenariat avec le Secrétariat à l’Internet haute vitesse et aux projets spéciaux de connectivité du Ministère du Conseil Exécutif 1, le projet présenté ici s’inscrit dans un contexte concret de développement territorial numérique, avec comme objectif principal l’identification de zones d’intérêt prioritaires pour le déploiement de la fibre optique (Internet haute vitesse)2. Ce mandat a permis de mettre en œuvre l’ensemble des compétences développées dans les cours du certificat, notamment :

SCI-1031 : Visualisation et analyse de données spatiales,

SCI-1018 : Statistique avec R,

SCI-1017 : Traitement des données massives,

SCI-1421 : Apprentissage machine.

En croisant des données géospatiales, sociodémographiques et techniques, le projet a exploité des méthodes statistiques, des algorithmes d’apprentissage non supervisé (comme DBSCAN)3 et des outils de traitement de grands volumes de données pour proposer des pistes concrètes d’intervention. L’approche adoptée est fondée sur une démarche rigoureuse : de la collecte des données jusqu’à la communication des résultats, en passant par leur nettoyage, leur exploration et leur modélisation.

Ce projet illustre l’apport stratégique des sciences des données dans la planification d’infrastructures critiques et témoigne du caractère avant-gardiste de la formation offerte dans le cadre du certificat.

1.1 État de la sitiuation

# Installer les librairies si nécessaires
if (!require("leaflet")) install.packages("leaflet")
if (!require("sf")) install.packages("sf")
if (!require("dplyr")) install.packages("dplyr")
if (!require("RColorBrewer")) install.packages("RColorBrewer")

library(readr)
library(dplyr)
library(leaflet)
library(sf)
library(RColorBrewer)

# Lire les données
setwd("~/Desktop/Teluq/SCI-1402/Data/")
df <- read.csv("resultat_sf.csv", sep = ",", header = TRUE, encoding = "UTF-8")

# Nettoyer les données
df_clean <- df %>%
  filter(!is.na(Longitude), !is.na(Latitude), !is.na(munnom)) %>%
  mutate(
    Longitude = as.numeric(Longitude),
    Latitude = as.numeric(Latitude),
    Region_ADM = as.factor(Region_ADM)
  )

# Générer une palette de couleurs selon munnom
Region_ADM_levels <- levels(df_clean$Region_ADM)
palette_Region_ADM_levels <- colorFactor(palette = brewer.pal(min(length(Region_ADM_levels), 8), "Set1"), domain = Region_ADM_levels)

# Créer la carte Leaflet
carte_munnom <- leaflet(df_clean) %>%
  addTiles(group = "Base") %>%
  addWMSTiles(
    baseUrl = "https://servicescarto.mern.gouv.qc.ca/pes/services/Territoire/SDA_WMS/MapServer/WMSServer",
    layers = "Région administrative",
    options = WMSTileOptions(format = "image/png", transparent = TRUE),
    attribution = "© MERN - Gouvernement du Québec",
    group = "Contours SDA"
  ) %>%
  addCircleMarkers(
    lng = ~Longitude,
    lat = ~Latitude,
    radius = 4,
    color = ~palette_Region_ADM_levels(Region_ADM),
    fillOpacity = 0.8,
    stroke = FALSE,
    label = ~paste0("Municipalité: ", munnom, "<br>Latitude: ", Latitude, "<br>Longitude: ", Longitude)
  ) %>%
  addLegend(
    position = "bottomright",
    pal = palette_Region_ADM_levels,
    values = ~Region_ADM,
    title = "Region_ADM",
    opacity = 1
  )

1.2 Statistiques par région

stats_region <- df_clean %>%
  filter(!is.na(Region_ADM)) %>%
  group_by(Region_ADM) %>%
  summarise(
    Nombre_points = n()
  ) %>%
  arrange(desc(Nombre_points))

library(kableExtra)

stats_region %>%
  kable("html", caption = "Nombre de points par région administrative") %>%
  kable_styling(full_width = FALSE, bootstrap_options = c("striped", "hover", "condensed"))
Nombre de points par région administrative
Region_ADM Nombre_points
Outaouais 6789
Montérégie 4333
Chaudière-Appalaches 3768
Laurentides 3445
Estrie 3200
Lanaudière 3129
Saguenay–Lac-Saint-Jean 3072
Montréal 2923
Centre-du-Québec 2322
Capitale-Nationale 2224
Bas-Saint-Laurent 2156
Abitibi-Témiscamingue 1921
Mauricie 1207
Laval 882
Côte-Nord 678
Nord-du-Québec 651
Gaspésie–Îles-de-la-Madeleine 359 
# Installer les librairies si nécessaires
if (!require("geojsonio")) install.packages("geojsonio")
if (!require("leaflet")) install.packages("leaflet")
if (!require("dbscan")) install.packages("dbscan")
if (!require("sf")) install.packages("sf")
if (!require("dplyr")) install.packages("dplyr")
if (!require("ggplot2")) install.packages("ggplot2")
if (!require("ggforce")) install.packages("ggforce")
if (!require("kableExtra")) install.packages("kableExtra")

library(readr)
library(dplyr)
library(dbscan)
library(leaflet)
library(sf)
library(geojsonio)
library(RColorBrewer)


coords <- df_clean %>%
  select(Longitude, Latitude) %>%
  as.matrix()

# Paramètres DBSCAN
eps_values <- seq(0.01, 0.03, by = 0.01)
minPts_values <- seq(70, 30, by = -10)

# Créer la carte Leaflet
carte <- leaflet() %>%
  addTiles(group = "Base") %>%
  addWMSTiles(
    baseUrl = "https://servicescarto.mern.gouv.qc.ca/pes/services/Territoire/SDA_WMS/MapServer/WMSServer",
    layers = "Région administrative",
    options = WMSTileOptions(format = "image/png", transparent = TRUE),
    attribution = "© MERN - Gouvernement du Québec",
    group = "Contours SDA"
  )

# Liste pour garder le nom des groupes
group_names <- c()

# Générer les itérations de clustering
for (eps in eps_values) {
  for (minPts in minPts_values) {
    label <- sprintf("eps=%.2f_minPts=%d", eps, minPts) 
    group_names <- c(group_names, label)
    
    # Appliquer DBSCAN
    db <- dbscan(coords, eps = eps, minPts = minPts)
    df_iter <- df_clean %>%
      mutate(cluster = as.factor(db$cluster))
    
       df_iter_grouped <- df_iter %>%
      filter(cluster != 0)
    
    # Ajouter le nombre de points par cluster
    cluster_counts <- df_iter_grouped %>%
      count(cluster, name = "n_points")
    
    df_iter_grouped <- df_iter_grouped %>%
      left_join(cluster_counts, by = "cluster")
    
    # Ajouter à la carte dans un groupe spécifique
    carte <- carte %>%
      addCircleMarkers(
        data = df_iter_grouped,
        lng = ~Longitude,
        lat = ~Latitude,
        #color = ~ifelse(cluster == 0, "gray", RColorBrewer::brewer.pal(8, "Set1")[as.integer(cluster)]),
        color = ~palette_Region_ADM_levels(Region_ADM),
        radius = ~ifelse(cluster == 0, 1, 4),
        fillOpacity = 0.8,
        stroke = FALSE,
        group = label,
        label = ~paste("Cluster:", cluster, ": Nb points:", n_points)
      )
  }
}

1.3 Carte interactive des regroupements

# Ajouter le contrôle des couches avec baseGroups
carte <- carte %>%
  addLayersControl(
    baseGroups = group_names,
    overlayGroups = c("Contours SDA"),
    options = layersControlOptions(collapsed = FALSE)
  ) %>%
  hideGroup(setdiff(group_names, group_names[1]))  # Cacher tous sauf le 1er

carte

1.4 Statistiques par itération DBSCAN pour la province

# Statistiques par itération DBSCAN pour le province au
res_dbscan <- list()

# Refaire les itérations pour calculer les stats
for (eps in eps_values) {
  for (minPts in minPts_values) {
    label <- sprintf("eps=%.2f_minPts=%d", eps, minPts)

    # Appliquer DBSCAN
    db <- dbscan(coords, eps = eps, minPts = minPts)
    clusters <- db$cluster
    
    n_total <- length(clusters)
    n_bruit <- sum(clusters == 0)
    n_regroupes <- n_total - n_bruit
    n_clusters <- length(unique(clusters)) - ifelse(any(clusters == 0), 1, 0) 
    
    pourcentage_regroupes <- (n_regroupes / n_total) * 100
    
    res_dbscan[[label]] <- data.frame(
      Paramètres = label,
      Nombre_de_clusters = n_clusters,
      Nombre_de_points_regroupes = n_regroupes,
      Pourcentage_de_points_regroupes = round(pourcentage_regroupes, 1)
    )
  }
}

# Combiner tous les résultats en un seul tableau
df_stats_dbscan <- do.call(rbind, res_dbscan)

library(knitr)
library(kableExtra)

# Afficher le tableau avec bordure
kable(df_stats_dbscan, caption = "Résumé statistique pour chaque itération de DBSCAN", format = "html") %>%
  kable_styling(bootstrap_options = c("striped", "bordered"), full_width = FALSE)
Résumé statistique pour chaque itération de DBSCAN
Paramètres Nombre_de_clusters Nombre_de_points_regroupes Pourcentage_de_points_regroupes
eps=0.01_minPts=70 eps=0.01_minPts=70 36 4758 11.0
eps=0.01_minPts=60 eps=0.01_minPts=60 43 5575 12.9
eps=0.01_minPts=50 eps=0.01_minPts=50 53 6406 14.9
eps=0.01_minPts=40 eps=0.01_minPts=40 76 7901 18.3
eps=0.01_minPts=30 eps=0.01_minPts=30 115 9815 22.8
eps=0.02_minPts=70 eps=0.02_minPts=70 54 9750 22.6
eps=0.02_minPts=60 eps=0.02_minPts=60 61 11108 25.8
eps=0.02_minPts=50 eps=0.02_minPts=50 76 12715 29.5
eps=0.02_minPts=40 eps=0.02_minPts=40 107 15204 35.3
eps=0.02_minPts=30 eps=0.02_minPts=30 155 18800 43.7
eps=0.03_minPts=70 eps=0.03_minPts=70 59 15572 36.2
eps=0.03_minPts=60 eps=0.03_minPts=60 72 17085 39.7
eps=0.03_minPts=50 eps=0.03_minPts=50 85 19249 44.7
eps=0.03_minPts=40 eps=0.03_minPts=40 107 21400 49.7
eps=0.03_minPts=30 eps=0.03_minPts=30 150 25064 58.2

1.5 Statistiques par itération DBSCAN par région administrative

# Extraire les minPts et eps depuis les labels
df_stats_dbscan <- df_stats_dbscan %>%
  mutate(
    eps = as.numeric(sub(".*eps=([0-9.]+)_minPts=.*", "\\1", rownames(df_stats_dbscan))),
    minPts = as.numeric(sub(".*minPts=([0-9]+)", "\\1", rownames(df_stats_dbscan)))
  )

library(ggplot2)

# Nuage de points : taille selon Nombre de clusters, couleur selon % de points regroupés
ggplot(df_stats_dbscan, aes(x = minPts, y = eps)) +
  geom_point(aes(size = Nombre_de_clusters, color = Pourcentage_de_points_regroupes), alpha = 0.8) +
  geom_text(aes(label = paste0(Pourcentage_de_points_regroupes, "%")), vjust = -0.5, size = 3) +
  scale_color_gradient(low = "red", high = "green") +
  scale_size_continuous(range = c(3, 10)) +  # contrôle la plage de taille
  scale_y_continuous(expand = expansion(mult = c(0.05, 0.15))) +
  scale_x_reverse() +
  labs(
    title = "Nuage de points: minPts vs eps",
    subtitle = "Taille = Nombre de clusters, Couleur = % de points regroupés",
    x = "Nombre minimum de points (minPts)",
    y = "Distance maximum (eps)",
    color = "% de points regroupés",
    size = "Nombre de clusters"
  ) +
  theme_minimal()

# DBSCAN par région
regions <- unique(df_clean$Region_ADM)

res_dbscan_region <- list()

for (region in regions) {
  
  df_region <- df_clean %>% filter(Region_ADM == region)
  
  coords_region <- df_region %>% 
    select(Longitude, Latitude) %>% 
    as.matrix()
  
  for (eps in eps_values) {
    for (minPts in minPts_values) {
      label <- sprintf("eps=%.2f_minPts=%d", eps, minPts)
      
      # Appliquer DBSCAN sur la région
      db <- dbscan(coords_region, eps = eps, minPts = minPts)
      clusters <- db$cluster
      
      n_total <- length(clusters)
      n_bruit <- sum(clusters == 0)
      n_regroupes <- n_total - n_bruit
      n_clusters <- length(unique(clusters)) - ifelse(any(clusters == 0), 1, 0)
      
      pourcentage_regroupes <- (n_regroupes / n_total) * 100
      
      res_dbscan_region[[paste(region, label)]] <- data.frame(
        Region_ADM = region,
        eps = eps,
        minPts = minPts,
        Nombre_de_clusters = n_clusters,
        Nombre_de_points_regroupes = n_regroupes,
        Pourcentage_de_points_regroupes = round(pourcentage_regroupes, 2)
      )
    }
  }
}



library(ggforce)

# Combiner tous les résultats
df_stats_dbscan_region <- do.call(rbind, res_dbscan_region)

# Déterminer le nombre total de régions
n_regions <- length(unique(df_stats_dbscan_region$Region_ADM))

# Déterminer le nombre de pages (2 régions par page)
n_pages <- ceiling(n_regions / 2)

for (i in 1:n_pages) {
  p <- ggplot(df_stats_dbscan_region, aes(x = minPts, y = eps)) +
    geom_point(aes(size = Nombre_de_clusters, color = Pourcentage_de_points_regroupes), alpha = 0.8) +
    geom_text(aes(label = paste0(Pourcentage_de_points_regroupes, "%")), vjust = -0.5, size = 2.5) +
    scale_color_gradient(low = "red", high = "green") +
    scale_size_continuous(range = c(2, 8)) +
    scale_y_continuous(expand = expansion(mult = c(0.05, 0.15))) +
    scale_x_reverse() +
    ggforce::facet_wrap_paginate(
      ~Region_ADM,
      ncol = 1,
      nrow = 2,   
      page = i
    ) +
    labs(
      title = "Clustering DBSCAN par Région administrative",
      subtitle = paste("Page", i, "sur", n_pages),
      x = "Nombre minimum de points (minPts)",
      y = "Distance maximum (eps)",
      color = "% de points regroupés",
      size = "Nombre de clusters"
    ) +
    theme_minimal()
  
  print(p)
}

1.6

2 Conclusion

3 Remerciements

Je tiens à remercier sincèrement tous les professeurs et tuteurs de l’Université TÉLUQ pour la qualité exceptionnelle de l’enseignement reçu tout au long du certificat en science des données. Votre approche rigoureuse, accessible et résolument avant-gardiste a grandement contribué à mon apprentissage et à mon développement professionnel. Merci pour votre engagement et votre passion.

Je tiens aussi à exprimer ma profonde gratitude envers l’équipe du Secrétariat Inter haute Vitesse et projets spéciaux en connectivité du Ministère du Conseil exécutif. Votre vision innovante, votre confiance et votre volonté constante de repousser les limites en matière de connectivité ont été une source d’inspiration tout au long de mon parcours. Merci pour votre engagement avant-gardiste au service du développement du numérique au Québec.

4 Références

  1. https://www.quebec.ca/gouvernement/ministeres-organismes/sihv↩︎

  2. Consulter la carte https://www.quebec.ca/habitation-territoire/amenagement-developpement-territoires/carte-internet-haute-vitesse↩︎

  3. Voir https://fr.wikipedia.org/wiki/DBSCAN pour plus d’information.↩︎